home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / tptc17tc.zip / QSORT.PAS < prev    next >
Pascal/Delphi Source File  |  1988-03-25  |  2KB  |  110 lines
  1.  
  2. (*
  3.  * Non-recursive quick sort
  4.  *)
  5.  
  6. program QuickSort;
  7.  
  8. const
  9.   N = 15000;
  10.   StackSize = 60;
  11.   InsertParam = 20;
  12. type
  13.   Index = 0..N;
  14. var
  15.   L, R, I, J, M : Index;
  16.   V, T : Integer;
  17.   S : 0..StackSize;
  18.   Stack : array[1..StackSize] of record
  19.                                   L, R : Index;
  20.                                 end;
  21.   A : array[Index] of Integer;
  22.  
  23. begin                         { qsort}
  24.   WriteLn('Non-recursive QuickSort...');
  25.   for I := 1 to N do
  26.     A[I] := I mod 500;
  27.   A[0] := -MaxInt;
  28.   S := 1;
  29.   Stack[1].L := 1;
  30.   Stack[1].R := N;
  31.   repeat
  32.     L := Stack[S].L;
  33.     R := Stack[S].R;
  34.     S := S-1;
  35.     while R-L > InsertParam do
  36.       begin
  37.         M := (L+R) div 2;
  38.         T := A[M];
  39.         A[M] := A[L+1];
  40.         A[L+1] := T;
  41.         if A[L+1] > A[R] then
  42.           begin
  43.             T := A[L+1];
  44.             A[L+1] := A[R];
  45.             A[R] := T;
  46.           end;
  47.         if A[L] > A[R] then
  48.           begin
  49.             T := A[L];
  50.             A[L] := A[R];
  51.             A[R] := T;
  52.           end;
  53.         if A[L+1] > A[L] then
  54.           begin
  55.             T := A[L+1];
  56.             A[L+1] := A[L];
  57.             A[L] := T;
  58.           end;
  59.         I := L+1;
  60.         J := R;
  61.         V := A[L];
  62.         repeat
  63.           repeat
  64.             I := I+1;
  65.           until A[I] >= V;
  66.           repeat
  67.             J := J-1;
  68.           until A[J] <= V;
  69.           if I < J
  70.           then begin
  71.             T := A[I];
  72.             A[I] := A[J];
  73.             A[J] := T;
  74.           end;
  75.         until I > J;
  76.         A[L] := A[J];
  77.         A[J] := V;
  78.         S := S+1;
  79.         if I-L < R-I then
  80.           begin
  81.             Stack[S].L := I;
  82.             Stack[S].R := R;
  83.             R := J-1;
  84.           end
  85.         else
  86.           begin
  87.             Stack[S].L := L;
  88.             Stack[S].R := J-1;
  89.             L := I;
  90.           end;
  91.       end;
  92.   until S = 0;
  93.  
  94.   for L := 1 to N-1 do
  95.     begin
  96.       if A[L] > A[L+1] then
  97.         begin
  98.           V := A[L+1];
  99.           I := L;
  100.           repeat
  101.             A[I+1] := A[I];
  102.             I := I-1;
  103.           until A[I] <= V;
  104.           A[I+1] := V;
  105.         end;
  106.     end;
  107.  
  108.   WriteLn('finished');
  109. end.
  110.